home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / stretch / form1.frm < prev    next >
Text File  |  1994-07-07  |  8KB  |  229 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   4605
  6.    ClientLeft      =   1080
  7.    ClientTop       =   1470
  8.    ClientWidth     =   5925
  9.    Height          =   5010
  10.    Left            =   1020
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4605
  13.    ScaleWidth      =   5925
  14.    Top             =   1125
  15.    Width           =   6045
  16.    Begin CommandButton Command4 
  17.       Caption         =   "Exit"
  18.       Height          =   375
  19.       Left            =   120
  20.       TabIndex        =   6
  21.       Top             =   2280
  22.       Width           =   855
  23.    End
  24.    Begin PictureBox Picture3 
  25.       Height          =   315
  26.       Left            =   120
  27.       ScaleHeight     =   285
  28.       ScaleWidth      =   825
  29.       TabIndex        =   5
  30.       Top             =   660
  31.       Width           =   855
  32.    End
  33.    Begin CommandButton Command3 
  34.       Caption         =   "Smaller"
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   4
  38.       Top             =   1860
  39.       Width           =   855
  40.    End
  41.    Begin CommandButton Command2 
  42.       Caption         =   "Bigger"
  43.       Height          =   375
  44.       Left            =   120
  45.       TabIndex        =   3
  46.       Top             =   1440
  47.       Width           =   855
  48.    End
  49.    Begin CommandButton Command1 
  50.       Caption         =   "Go"
  51.       Height          =   375
  52.       Left            =   120
  53.       TabIndex        =   1
  54.       Top             =   1020
  55.       Width           =   855
  56.    End
  57.    Begin PictureBox Picture1 
  58.       AutoRedraw      =   -1  'True
  59.       AutoSize        =   -1  'True
  60.       Height          =   510
  61.       Left            =   480
  62.       Picture         =   FORM1.FRX:0000
  63.       ScaleHeight     =   480
  64.       ScaleWidth      =   480
  65.       TabIndex        =   0
  66.       Top             =   60
  67.       Width           =   510
  68.    End
  69.    Begin PictureBox Picture2 
  70.       AutoRedraw      =   -1  'True
  71.       Height          =   1215
  72.       Left            =   1080
  73.       ScaleHeight     =   79
  74.       ScaleMode       =   3  'Pixel
  75.       ScaleWidth      =   95
  76.       TabIndex        =   2
  77.       Top             =   60
  78.       Width           =   1455
  79.    End
  80. End
  81. Sub Command1_Click ()
  82. Dim PL As Single, PW As Single, PT As Single, PH As Single
  83. Dim Color() As Long
  84. Dim I As Single, J As Single, IOff As Single
  85.  
  86. Picture2.Cls                        'Clear previous graphics
  87. Picture2.Picture = LoadPicture()    'Clear previous picture
  88. Picture2.Refresh
  89. Picture3.Cls
  90. Picture3.Scale (0, 0)-(100, 100) 'Makes status bar math easier for me.
  91.  
  92. PL = Picture1.ScaleLeft
  93. PW = Picture1.ScaleWidth
  94. PT = Picture1.ScaleTop
  95. PH = Picture1.ScaleHeight
  96.  
  97. ReDim Color(PW - PL, PH - PT) As Long 'Resize the array to match Picture1's scale mode.
  98.                                       'Did it backwards just for fun.
  99. Form1.MousePointer = 11
  100. For I = PL To PW     'Left to right
  101.     For J = PT To PH 'Top to bottom
  102.         Color(I, J) = Picture1.Point(I, J) 'Get pixel color and assign to array.
  103.     Next
  104. Picture3.Line (0, 0)-(I / PW * 100, 100), , BF 'Update status bar once each major loop.
  105. Next
  106. Picture3.Cls 'Clear staus bar for stretch loop.
  107. For I = PL To PW     'Left to right
  108.     For J = PT To PH 'Top to bottom
  109.         On Error Resume Next  'Could someone tell me how to get this line out?
  110.         Picture2.Line (I, J)-(I + 1, J + 1), Color(I, J), BF 'Get color from array and draw one "pixel".
  111.             'Interesting stuff here. The line method will not
  112.             'draw the end point. And if you dont give it more
  113.             'than one "pixel" to draw, you get nothing.
  114.  
  115.         'Picture2.Refresh  ' Un-Comment this if you want to watch the stretched being drawn.
  116.         'DoEvents 'This one does the same thing, from a speed perspective.
  117.     Next
  118. Picture3.Line (0, 0)-(I / PW * 100, 100), , BF 'Update status bar once each major loop.
  119. Next
  120.  
  121. IOff = 1 / PH 'Corrects for slight difference between sizes
  122.               'of boxes in first and last grid rows and columns
  123.               'Doesn't work if Picture2 is too small
  124.  
  125. For I = 1 To PH - 1
  126.     Picture2.Line (0, I - IOff)-(PW, I - IOff) 'Draw horizontal lines
  127. Next
  128.  
  129. IOff = 1 / PW 'Corrects for slight difference between
  130.               'locations of first and last grid lines
  131.               'Doesn't work if Picture2 is too small
  132.  
  133. For I = 1 To PW - 1
  134.     Picture2.Line (I - IOff, 0)-(I - IOff, PH) 'Draw verticle lines
  135. Next
  136. Picture2.Picture = Picture2.Image 'In case you want to save it
  137. Picture2.Refresh
  138. Form1.MousePointer = 0
  139. 'MsgBox Str$(I * J) 'This will tell you the number of pixels stored in the array.
  140. End Sub
  141.  
  142. Sub Command2_Click ()
  143. Picture2.Width = Picture2.Width * 1.5
  144. Picture2.Height = Picture2.Height * 1.5
  145.  
  146. Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  147. 'This, in combination with the Line...BF method, is what
  148. 'actually does the stretching (or shrinking). The effect,
  149. 'since Picture1's ScaleMode is pixels, is that you are
  150. 'simply drawing large, square pixels.
  151. End Sub
  152.  
  153. Sub Command3_Click ()
  154. Picture2.Width = Picture2.Width * .75
  155. Picture2.Height = Picture2.Height * .75
  156.  
  157. Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  158. 'This, in combination with the Line...BF method, is what
  159. 'actually does the stretching (or shrinking). The effect,
  160. 'since Picture1's ScaleMode is pixels, is that you are
  161. 'simply drawing large, square pixels.
  162.  
  163. End Sub
  164.  
  165. Sub Command4_Click ()
  166. End
  167. End Sub
  168.  
  169. Sub Form_Load ()
  170.     Picture1.ScaleMode = 3 'Pixels
  171.     Picture2.Width = Picture1.Width
  172.     Picture2.Height = Picture1.Height
  173.     Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  174.     'The above line is also in the click events that
  175.     'resize Picture2, Commands 2 and 3
  176. End Sub
  177.  
  178. Sub Picture1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  179.     MsgBox Str$(Picture1.Point(X, Y)) 'Get the color of the pixel under the cursor
  180. End Sub
  181.  
  182. Sub Picture2_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  183.     MsgBox Str$(Picture2.Point(X, Y))  'Get the color of the pixel under the cursor
  184. End Sub
  185.  
  186. Sub Read_Me ()
  187. 'To use this thing, just run it and click "Bigger" a couple
  188. 'times, then click "Go".
  189.  
  190. 'All the goodies are in the click events and picture mousedowns
  191. 'I know they should be in a sub or two, but after all, this
  192. 'was playtime. I just felt like seeing what the Point method
  193. 'was all about since most of the time I'm a database idiot.
  194. 'I also wanted to see what I could do with VB instead of
  195. 'using StretchBlt.
  196.  
  197. 'I started out to do this by using an Image control to stretch
  198. 'the image but I ran into trouble when I tried to transfer
  199. 'the stretched image to a picture control (for the grid),
  200. 'since the image control has no image property(?!). Or for
  201. 'that matter an hWnd property. I also didn't feel like
  202. 'playing with hDCs. The result of all this negativity is what
  203. 'you see here. I hope you find it amusing.
  204.  
  205. 'If for some strange reason you decide to use this in one of
  206. 'your apps, please thank me somewhere in it's documetation,
  207. 'or offer me a job (no joke).
  208.  
  209. 'One question I have about it is this. If one were doing a
  210. 'MDI or other multiple image graphics app, would there be any
  211. 'benefit in assigning a third dimension to the array Color()
  212. 'in Command1 and assigning different images to that third
  213. 'dimension, or should each image have it's own array. I realize
  214. 'it would have to be declared elsewhere. Or should one always
  215. 're-read the original image. I realize memory could get full
  216. 'pretty fast but hey, Chicago's coming which means we'll all
  217. 'be customers at Memory Express <G>.
  218.  
  219. 'If there isn't enough comments in the code, drop me a line
  220. 'at 72123,1243 or at AaronCr on AOL (aaroncr@aol.com) or
  221. 'leave me a note in the Basic Forum.
  222.  
  223. 'Enjoy!
  224.  
  225. 'Aaron P. Crouse
  226.  
  227. End Sub
  228.  
  229.